home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr53
/
pctv4n_1.zip
/
ERRTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-06-10
|
3KB
|
109 lines
{ LISTING 2 : ERRTEST.PAS }
UNIT ErrTest;
INTERFACE
USES
WinTypes,WinProcs,WObjects,WinDos,Strings,Error;
TYPE
pErrorProneObject = ^tErrorProneObject;
tErrorProneObject = OBJECT(tObject)
Error: pError;
CONSTRUCTOR Init;
DESTRUCTOR Done; VIRTUAL;
PROCEDURE AttachErrorObject(NewError: pError);
PROCEDURE DoSomethingDangerous;
END;
pErrorProneOwner = ^tErrorProneOwner;
tErrorProneOwner = OBJECT(tObject)
Error: pError;
ErrorProneObject: tErrorProneObject;
CONSTRUCTOR Init;
DESTRUCTOR Done; VIRTUAL;
PROCEDURE AttachErrorObject(NewError: pError);
PROCEDURE DoSomethingDangerous;
END;
{===============================================================}
IMPLEMENTATION
{---------------- tErrorProneObject Methods --------------------}
CONSTRUCTOR tErrorProneObject.Init;
BEGIN
tObject.Init;
New(Error, Init (@Self, 'Error Prone Object'));
END;
{---------------------------------------------------------------}
DESTRUCTOR tErrorProneObject.Done;
BEGIN
IF (@Self = Error^.Owner) THEN Dispose(Error, Done);
tObject.Done;
END;
{---------------------------------------------------------------}
PROCEDURE tErrorProneObject.AttachErrorObject(NewError: pError);
BEGIN
IF (Error^.Owner = @Self) THEN Dispose(Error, Done);
Error := NewError;
END;
{---------------------------------------------------------------}
PROCEDURE tErrorProneObject.DoSomethingDangerous;
FUNCTION DoDangerousThing: Boolean;
BEGIN
DoDangerousThing := True;
END;
CONST
ERR_ThingFailed = 100;
ERR_ThingFaltered = 101;
VAR Success: Boolean;
BEGIN
{ When an object performs a dangerous task directly, and that
task fails, it sets the error condition. }
IF (NOT DoDangerousThing) THEN BEGIN
Error^.SetError(ERR_ThingFailed, ERR_Severe, False, @Self);
Exit;
END;
{ Some tasks, like writing to disk, may falter but (under
Windows) can be retried. }
REPEAT
Success := DoDangerousThing;
IF (NOT Success) THEN
Error^.SetError(ERR_ThingFaltered,ERR_Severe,True,@Self);
UNTIL (Success OR Error^.NoError(@Self));
END;
{---------------- tErrorProneOwner Methods ---------------------}
CONSTRUCTOR tErrorProneOwner.Init;
BEGIN
tObject.Init;
New (Error, Init(@Self, 'Error Prone Owner'));
ErrorProneObject.Init;
ErrorProneObject.AttachErrorObject(Error);
END;
{---------------------------------------------------------------}
DESTRUCTOR tErrorProneOwner.Done;
BEGIN
IF (@Self=Error^.Owner) THEN Dispose(Error, Done);
ErrorProneObject.Done;
tObject.Done;
END;
{---------------------------------------------------------------}
PROCEDURE tErrorProneOwner.AttachErrorObject (NewError: pError);
BEGIN
IF (Error^.Owner=@Self) THEN Dispose(Error, Done);
Error := NewError;
ErrorProneObject.AttachErrorObject(NewError);
END;
{---------------------------------------------------------------}
PROCEDURE tErrorProneOwner.DoSomethingDangerous;
BEGIN
ErrorProneObject.DoSomethingDangerous;
IF (ErrorProneObject.Error^.NoError(@Self)) THEN
(* Do other stuff *)
ELSE
(* Message will have been displayed IF @Self is still
Error owner; IF @Self is a property of yet another
object, message will not be displayed until
real owner checks for error. *)
END;
END.